unit Main;

interface

uses
{$IFDEF CLR}
  System.ComponentModel,
  System.Runtime.InteropServices,
{$ENDIF}
  Classes, DBXpress, FMTBcd, DB, SqlExpr, DBXInfExt,
{$IFDEF LINUX}
  QGraphics, QControls, QForms, QDialogs, QStdCtrls, QComCtrls, QActnList,
{$ELSE}
  Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, ActnList;
{$ENDIF}

type
  TFormMain = class(TForm)
    sqlConnection: TSQLConnection;
    pageControl: TPageControl;
    tabsheetConnection: TTabSheet;
    tabsheetQuery: TTabSheet;
    memoConnectionParams: TMemo;
    labelConnectionParameters: TLabel;
    buttonConnect: TButton;
    buttonDisconnect: TButton;
    actionList: TActionList;
    actionConnect: TAction;
    actionDisconnect: TAction;
    actionExecute: TAction;
    actionInterrupt: TAction;
    labelSQL: TLabel;
    memoSQL: TMemo;
    buttonExecute: TButton;
    buttonInterrupt: TButton;
    labelUserName: TLabel;
    editUserName: TEdit;
    labelPassword: TLabel;
    editPassword: TEdit;
    memoDummyProcedure: TMemo;
    checkboxEnableInterruption: TCheckBox;
    buttonCreateDummy: TButton;
    buttonDropDummy: TButton;
    labelDummyProcedure: TLabel;
    actionCreateDummy: TAction;
    actionDropDummy: TAction;
    labelDatabase: TLabel;
    editDatabase: TEdit;
    labelServerVersion: TLabel;
    procedure actionConnectExecute(Sender: TObject);
    procedure actionDisconnectExecute(Sender: TObject);
    procedure actionExecuteExecute(Sender: TObject);
    procedure actionInterruptExecute(Sender: TObject);
    procedure actionListUpdate(Action: TBasicAction; var Handled: Boolean);
    procedure actionCreateDummyExecute(Sender: TObject);
    procedure actionDropDummyExecute(Sender: TObject);
    procedure checkboxEnableInterruptionClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
{$IFDEF CLR}
    FConnHandle: GCHandle;
{$ENDIF}
    procedure SetTimeOut;
  end;

var
  FormMain: TFormMain;

implementation

{$R *.dfm}

procedure TFormMain.actionConnectExecute(Sender: TObject);
begin
{$IFDEF LINUX}
  sqlConnection.LibraryName := 'lxdbexpinfpro.so';
{$ENDIF}
  sqlConnection.Params.Values['HostName'] := memoConnectionParams.Text;
  sqlConnection.Params.Values['Database'] := editDatabase.Text;
  sqlConnection.Params.Values['User_Name'] := editUserName.Text;
  sqlConnection.Params.Values['Password'] := editPassword.Text;
  sqlConnection.Open;
  labelServerVersion.Caption := 'Connected to: ' + IInformixConnection(
    sqlConnection.SQLConnection).ServerVersion;
  SetTimeOut;
end;

procedure TFormMain.actionDisconnectExecute(Sender: TObject);
begin
  sqlConnection.Close;
  labelServerVersion.Caption := 'Not connected';
end;

procedure TFormMain.actionCreateDummyExecute(Sender: TObject);
begin
  sqlConnection.ExecuteDirect(memoDummyProcedure.Text);
end;

procedure TFormMain.actionDropDummyExecute(Sender: TObject);
begin
  sqlConnection.ExecuteDirect('drop procedure dummy');
end;

procedure TFormMain.actionExecuteExecute(Sender: TObject);
begin
  sqlConnection.ExecuteDirect(memoSQL.Text);
end;

procedure TFormMain.actionInterruptExecute(Sender: TObject);
begin
  with IInformixConnection(sqlConnection.SQLConnection) do
    if not interruptSQL then
      ShowMessage(ErrorMessage);
end;

procedure TFormMain.actionListUpdate(Action: TBasicAction;
  var Handled: Boolean);
begin
  actionConnect.Enabled := not sqlConnection.Connected;
  actionDisconnect.Enabled := sqlConnection.Connected;
  actionExecute.Enabled := sqlConnection.Connected;
  actionInterrupt.Enabled := sqlConnection.Connected;
  actionCreateDummy.Enabled := sqlConnection.Connected;
  actionDropDummy.Enabled := sqlConnection.Connected;
  checkboxEnableInterruption.Enabled := sqlConnection.Connected;
end;

{$IFDEF CLR}
procedure OnTimeOut(CustomData: IntPtr; Status: Integer);
var
  Connection: TSQLConnection;
begin
  Connection := TSQLConnection(GCHandle(CustomData).Target);
  Application.ProcessMessages;
end;
{$ELSE}
procedure OnTimeOut(CustomData: Pointer; Status: Integer); stdcall;
var
  Connection: TSQLConnection;
begin
  Connection := TSQLConnection(CustomData);
  Application.ProcessMessages;
end;
{$ENDIF}

// Delphi 8 - we have to hold reference to the callback delegate all time,
// because garbage collector can free passed into unmanaged code delegate reference
var
  Callback: TimeOutCallback = OnTimeOut;

procedure TFormMain.checkboxEnableInterruptionClick(Sender: TObject);
begin
  SetTimeOut;
end;

procedure TFormMain.SetTimeOut;
var
  Status: SQLResult;
begin
  with IInformixConnection(sqlConnection.SQLConnection) do
  begin
    if checkboxEnableInterruption.Checked then
{$IFDEF CLR}
      Status := setTimeOutCallback(500, Callback, IntPtr(FConnHandle))
{$ELSE}
      Status := setTimeOutCallback(500, Callback, sqlConnection)
{$ENDIF}
    else
      Status := setTimeOutCallback(-1, nil, nil);
    if Status <> 0 then
      ShowMessage(ErrorMessage);
  end;
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
{$IFDEF CLR}
  FConnHandle := GCHandle.Alloc(sqlConnection);
{$ENDIF}
end;

procedure TFormMain.FormDestroy(Sender: TObject);
begin
{$IFDEF CLR}
  FConnHandle.Free;
{$ENDIF}
end;

end.
